home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / HDPACK.M < prev    next >
Encoding:
Text File  |  1989-03-10  |  26.7 KB  |  703 lines
  1. MODULE HDPack;
  2. (* Optimiere Festplattenbelegung:
  3.    - Sortiere Verzeichnisse so, daß Unterverzeichnisse vor den Files stehen
  4.    - Speichere alle (Unter-)Verzeichnisse ab dem 'Anfang' der Festplatte
  5.    - Speichere alle Datenfiles ab dem 'Ende' der Festplatte
  6.  
  7.    Florian Matthes 18.10.1987  (TDI-Modula Version 3.0)
  8.    Thomas Tempelmann 6.4.88    (Anpassung f. Megamax M-2 V1)
  9. *)
  10.  
  11. IMPORT TOSIO;
  12. FROM SYSTEM IMPORT ADR, ADDRESS, TSIZE, VAL;
  13. FROM InOut  IMPORT WriteCard, WriteString, WriteLn, Write, Read;
  14. IMPORT BIOS;
  15.  
  16. CONST (* Spezielle Einträge in der FAT:                                   *)
  17.       FreeCluster   = 0;         (* dieser Cluster ist unbelegt           *)
  18.       FirstCluster  = 2;         (* Offset zur Umwandlung Cluster-Sektor  *)
  19.       BadCluster    = 0FFF7H;    (* dieser Cluster ist defekt             *)
  20.                                  (* z.B. Plattenfehler (nicht verwenden)  *)
  21.       EOFCluster    = 0FFF8H;    (* Cluster mit diesem oder einem höheren *)
  22.                                  (* Index sind der letzte Cluster eines   *)
  23.                                  (* Files                                 *)
  24.       MaxPhysCluster= 03FFFH;    (* maximale Clustergröße für HDPack      *)
  25.                                  (* ==> FAT ist kleiner als 64K           *)
  26.       MaxCluster    = 0FFFFH;    (* theoretisches Maximum und auch        *)
  27.                                  (* von ATARI-BIOS tatsächlich erwartetes *)
  28.                                  (* EOFCluster                            *)
  29.                               
  30.       MaxDirectoryBlocks = 64;   (* beschränkt Sektorgröße in HDPack auf  *)
  31.                                  (* 64*TSIZE(DirectoryRecord)= 64K        *)
  32.                               
  33.       (* der Inhalt des ersten Buchstabens eines Filenamens in einem      *)
  34.       (* Directory kennzeichnet dessen Typ:                               *)
  35.       FreeName      = 0H;        (* Eintrag noch nie benutzt              *)
  36.       UnusedName    = 0E5H;      (* Eintrag nicht mehr benutzt            *)
  37.       SpecialName   = 02EH;      (* = ORD('.') reservierte Namen:         *)
  38.                                  (* '.'   zeigt auf lfd. Directory        *)
  39.                                  (* '..'  zeigt auf VaterDirectory        *)
  40.  
  41. TYPE ClusterIndex = [0..MaxCluster];
  42.      ClusterIndex8086 = CARDINAL;
  43.                     (* Wie bei 80xxx Prozessoren: H und L-Byte vertauscht *)
  44.      attributset =  SET OF (readonlyattr,
  45.                             hiddenattr,
  46.                             systemattr,
  47.                             volumeattr,
  48.                             subdirattr,  (* dieses File ist ein Directory *)
  49.                             archivattr);
  50.      DirectoryRecord    = RECORD
  51.                             Name        : ARRAY[0..10] OF CHAR;
  52.                                                 (* Filename und Extension *)
  53.                             Attr        : attributset;
  54.                                                 (* Typ des Files          *)
  55.                             res         : ARRAY[0..13] OF CHAR;
  56.                                                 (* reserviert             *)
  57.                             StartCluster: ClusterIndex;
  58.                                                 (* 1. Cluster des Files   *)
  59.                             Size        : LONGCARD;
  60.                                                 (* Filegröße in Bytes     *)
  61.                           END;
  62.      DirectoryArray     = ARRAY[0..MaxDirectoryBlocks-1] OF DirectoryRecord;
  63.                           (* Struktur eines Sektors in einem Directory    *)
  64.   
  65. VAR (* Die 'File Allocation Table' enthält folgende Informationen:
  66.        Index 0   Format Version
  67.              1   unbenutzt
  68.              2..MaxPhysCluster  Belegung des jeweiligen Clusters
  69.        OrgFAT : FAT vor dem Optimieren
  70.        NewFAT : FAT nach dem Optimieren
  71.     *)
  72.     OrgFAT, NewFAT           : ARRAY [0..MaxPhysCluster] OF ClusterIndex8086;
  73.     NewPos, OldPos           : ARRAY [0..MaxPhysCluster] OF ClusterIndex;
  74.     (* NewPos[i] liefert die momentane Position des ehemals i-ten Cluster
  75.        OldPos[i] liefert die ehemalige Position des momentan i-ten Cluster
  76.     *)
  77.     BPBPtr                   : BIOS.BPBPtr;
  78.     (* Zeiger auf BIOS Parameterblock für dev. Die Deklaration in BIOS ist:
  79.                     POINTER TO RECORD
  80.                                  recsiz, clsiz, clsizb, rdlen, fsiz,
  81.                                  fatrec, datrec, numcl, bflags: CARDINAL;
  82.                                END;
  83.      *)
  84.     dev                      : CARDINAL;(* Gerätenummer 0 = 'A:', 1 ='B:' *)
  85.     (* aus BPBPtr^ abgeleitete Größen:                                    *)
  86.     SectorsPerCluster        : CARDINAL;
  87.     FirstDataSector          : CARDINAL;
  88.     DirectoryRecordsPerSector: CARDINAL;
  89.     FirstDirectorySector     : CARDINAL;
  90.   
  91. VAR CH:CHAR;
  92.  
  93.   PROCEDURE Abort(x: ARRAY OF CHAR; nochanges: BOOLEAN);
  94.   (* Programmabbruch mit Fehlermeldung
  95.   *)
  96.   BEGIN
  97.     WriteLn; WriteString(x); WriteLn;
  98.     IF nochanges THEN
  99.       WriteString('Keine Änderungen auf Platte durchgeführt.');
  100.     ELSE
  101.       WriteString('Leider sind wahrscheinlich einige Files zerstört worden.');
  102.     END;
  103.     WriteLn;
  104.     WriteString('weiter mit einer beliebigen Taste...'); WriteLn;
  105.     Read(CH);
  106.     HALT;  (* Beende Programmausführung mit Fehlermeldung *)
  107.   END Abort;
  108.  
  109.   PROCEDURE SwapLH(x:CARDINAL): CARDINAL;
  110.   (* Tausche Low und High-Byte (Umwandlung zwischen 80xx - 68000 Format)
  111.   *)
  112.   BEGIN
  113.     RETURN 256 * (x MOD 256) + (x DIV 256)
  114.   END SwapLH;
  115.  
  116.   PROCEDURE ClusterToSector(x: ClusterIndex): CARDINAL;
  117.   (* Berechne den ersten Sektor, in dem der Cluster x beginnt
  118.   *)
  119.   BEGIN
  120.     RETURN (x-FirstCluster) * SectorsPerCluster + FirstDataSector;
  121.   END ClusterToSector;
  122.  
  123.   PROCEDURE SectorToCluster(x: CARDINAL): ClusterIndex;
  124.   (* Berechne den Cluster, in dem sich der Sektor x befindet
  125.   *)
  126.   BEGIN
  127.     RETURN (x-FirstDataSector) DIV SectorsPerCluster + FirstCluster;
  128.   END SectorToCluster;
  129.  
  130.   PROCEDURE Next(x:ClusterIndex): ClusterIndex;
  131.   (* liefere den Nachfolger des Clusters gemäß FAT
  132.   *)
  133.   BEGIN
  134.     RETURN SwapLH(OrgFAT[x]);
  135.   END Next;
  136.  
  137.   PROCEDURE ReadAbs(buf          : ADDRESS;  (* in diesen Puffer         *)
  138.                     count        : CARDINAL; (* Anzahl der Sektoren      *)
  139.                     recno        : CARDINAL; (* Index erster Sektor      *)
  140.                     VAR errorcode: CARDINAL);(* BIOS-Erfolgsmeldung      *)
  141.   BEGIN
  142.     errorcode:= VAL (CARDINAL,BIOS.RWAbs(BIOS.Read,buf,count,recno,dev));
  143.   END ReadAbs;
  144.  
  145.   PROCEDURE WriteAbs(buf         : ADDRESS;  (* in diesen Puffer         *)
  146.                     count        : CARDINAL; (* Anzahl der Sektoren      *)
  147.                     recno        : CARDINAL; (* Index erster Sektor      *)
  148.                     VAR errorcode: CARDINAL);(* BIOS-Erfolgsmeldung      *)
  149.   BEGIN
  150.     errorcode:= VAL (CARDINAL,BIOS.RWAbs(BIOS.Write,buf,count,recno,dev));
  151.   END WriteAbs;
  152.  
  153.   PROCEDURE LocateDirectoryRecord(Cluster, Index  : CARDINAL;
  154.                               VAR Sector, Offset  : CARDINAL): BOOLEAN;
  155.   (* Lokalisiere indizierten Directory-Eintrag auf der Platte. Beachte
  156.      bereits stattgefundene Tauschoperationen.
  157.      Das Funktionsergebnis ist FALSE, falls dieser Eintrag nicht existiert.
  158.      Eingabe:
  159.        Cluster:  1. Cluster des zu bearbeitenden Directories (Position
  160.                  vor dem Optimieren). Ist Cluster = 0, so handelt es sich
  161.                  um das Wurzelverzeichnis.
  162.        Index  :  Index des gewünschten Eintrages (ab 0 gezählt)
  163.      Ausgabe:
  164.        Sector :  Sektor, in dem sich der Eintrag auf Platte befindet
  165.        Offset :  Index des Eintrages in diesem Sector (ab 0 gezählt)
  166.      Beispiel :
  167.        LocateDirectoryRecord(1234, 15, sec, offs)
  168.        bestimmt den Sektor, in dem der 16. Filenamen des Unterverzeichnisses
  169.        steht, das im Cluster 1234 beginnt. Innerhalb dieses Sektors (sec)
  170.        steht der Filenamen an der Position offs.
  171.    *)
  172.   BEGIN
  173.     IF Cluster = 0 THEN                (* Suche im Wurzelverzeichnis      *)
  174.       Sector:= Index DIV DirectoryRecordsPerSector;
  175.       IF Sector+1>BPBPtr^.rdlen THEN   (* nicht über das Ende hinausgehen *)
  176.         RETURN FALSE
  177.       END;
  178.       INC(Sector, FirstDirectorySector);
  179.     ELSE
  180.       LOOP                        (* durchlaufe das Directory sektorweise *)
  181.         IF Cluster>= EOFCluster THEN   (* nicht über das Ende hinausgehen *)
  182.           RETURN FALSE
  183.         END;
  184.         IF Index<DirectoryRecordsPerSector*SectorsPerCluster THEN
  185.           EXIT;
  186.         END;
  187.         Cluster:= Next(Cluster);
  188.         DEC(Index, DirectoryRecordsPerSector*SectorsPerCluster);
  189.       END;
  190.       Sector:= ClusterToSector(NewPos[Cluster]) +
  191.                Index DIV DirectoryRecordsPerSector;
  192.     END;
  193.     Offset:= Index MOD DirectoryRecordsPerSector;
  194.     RETURN TRUE;
  195.   END LocateDirectoryRecord;
  196.  
  197.   PROCEDURE GetDirectoryRecord(Cluster: CARDINAL;
  198.                                Index  : CARDINAL;
  199.                                VAR r  : DirectoryRecord): BOOLEAN;
  200.   (* Hole Eintrag r mit diesem Index (0...).
  201.      Ergebnis = FALSE, falls dieser Eintrag nicht existiert.
  202.   *)
  203.      VAR Sector, Offset : CARDINAL;
  204.          DirectorySector: DirectoryArray;
  205.          errorcode      : CARDINAL;
  206.   BEGIN
  207.     IF LocateDirectoryRecord(Cluster, Index, Sector, Offset) THEN
  208.       ReadAbs(ADR(DirectorySector),1,Sector,errorcode);
  209.       r:= DirectorySector[Offset];
  210.       RETURN (errorcode=0) AND (ORD(r.Name[0]) # FreeName);
  211.     ELSE
  212.       RETURN FALSE;
  213.     END;
  214.   END GetDirectoryRecord;
  215.  
  216.   PROCEDURE PutDirectoryRecord(Cluster: CARDINAL;
  217.                                Index  : CARDINAL;
  218.                                r      : DirectoryRecord): BOOLEAN;
  219.   (* Schreibe Eintrag mit diesem Index (0...).
  220.      Ergebnis = FALSE, falls dieser Eintrag nicht existiert.
  221.   *)
  222.      VAR Sector, Offset : CARDINAL;
  223.          DirectorySector: DirectoryArray;
  224.          errorcode      : CARDINAL;
  225.   BEGIN
  226.     IF LocateDirectoryRecord(Cluster, Index, Sector, Offset) THEN
  227.       ReadAbs(ADR(DirectorySector),1,Sector,errorcode);
  228.       IF errorcode#0 THEN
  229.         RETURN FALSE;
  230.       END;
  231.       DirectorySector[Offset]:= r;
  232.       WriteAbs(ADR(DirectorySector),1,Sector,errorcode);
  233.       RETURN errorcode=0;
  234.     ELSE
  235.       RETURN FALSE;
  236.     END;
  237.   END PutDirectoryRecord;
  238.  
  239.   PROCEDURE SortDirectory(StartCl: CARDINAL);
  240.   (* Sortiere (Unter-)Verzeichnisse so, daß Unterverzeichnisnamen vor
  241.      den 'normalen' Filenamen auftreten: Dabei ist kein Update der FAT
  242.      nötig, da alle Vertauschungen innerhalb des Files stattfinden.
  243.      Sortieralgorithmus: Direktes Einfügen
  244.   *)
  245.     VAR r,r2   : DirectoryRecord;
  246.         i,j,x,y: CARDINAL;
  247.   BEGIN
  248.     (* Zunächst rekursiv alle Söhne sortieren: *)
  249.     i:= 0;
  250.     WHILE GetDirectoryRecord(StartCl,i,r) DO
  251.       WITH r DO
  252.         x:= ORD(Name[0]);
  253.         IF (x <> UnusedName) AND (x <> SpecialName) AND
  254.            (subdirattr IN Attr) THEN
  255.           SortDirectory(SwapLH(StartCluster));
  256.         END;
  257.       END;
  258.       INC(i);
  259.     END; (* WHILE *)
  260.  
  261.     (* jetzt eigenes Directory sortieren: *)
  262.     i:= 0;
  263.     WHILE GetDirectoryRecord(StartCl,i,r) DO
  264.       WITH r DO
  265.        x:= ORD(Name[0]);
  266.         IF (x <> UnusedName) AND (x <> SpecialName) AND
  267.           NOT(subdirattr IN Attr) THEN
  268.           (* i zeigt auf den ersten Eintrag im Directory, der keinen
  269.              Unterverzeichnisnamen enthält
  270.           *)
  271.           j:= i+1;
  272.           LOOP
  273.             IF NOT GetDirectoryRecord(StartCl,j,r2) THEN
  274.               RETURN;
  275.               (* Sortierung beendet, da kein Unterverzeichniseintrag
  276.                  mehr gefunden wurde.
  277.                *)
  278.             END;
  279.             y:= ORD(r2.Name[0]);
  280.             IF (y <> UnusedName) AND (y <> SpecialName)
  281.             AND (subdirattr IN r2.Attr) THEN
  282.               (* j zeigt auf den ersten Unterverzeichnisnamen nach i
  283.               *)
  284.               WriteString('Tausche Directory-Einträge: ');
  285.               WriteString(Name); WriteString(' mit ');
  286.               WriteString(r2.Name); WriteLn;
  287.               IF NOT PutDirectoryRecord(StartCl, j, r) THEN
  288.                 WriteString(r.Name);
  289.                 WriteString(" kann nicht geschrieben werden ");
  290.                 WriteLn; Read (CH); RETURN;
  291.               ELSIF NOT PutDirectoryRecord(StartCl, i, r2) THEN
  292.                 WriteString(r2.Name);
  293.                 WriteString(" kann nicht geschrieben werden ");
  294.                 WriteLn; Read (CH); RETURN;
  295.               END;
  296.               EXIT;
  297.             END;
  298.             INC(j);
  299.           END;
  300.         END; (* IF *)
  301.       END; (* WITH *)
  302.       INC(i);
  303.     END; (* WHILE *)
  304.   END SortDirectory;
  305.  
  306.   PROCEDURE CountFree(): CARDINAL;
  307.   (* zähle die unbelegten Cluster auf der Platte
  308.   *)
  309.      VAR i,Free: CARDINAL;
  310.   BEGIN
  311.     Free:= 0;
  312.     FOR i:= FirstCluster TO BPBPtr^.numcl-1 DO
  313.       IF OrgFAT[i]=FreeCluster THEN INC(Free); END;
  314.     END;
  315.     RETURN Free;
  316.   END CountFree;
  317.  
  318.   (* Die folgenden Variablen werden global von der Prozedur MoveFile
  319.      verändert:
  320.   *)
  321.   VAR DestCluster         : ClusterIndex; (* Ziel für nächsten Cluster    *)
  322.       FirstFreeDestCluster: ClusterIndex; (* Ziel für ersten Datencluster *)
  323.  
  324.   PROCEDURE MoveFile(Cluster: CARDINAL);
  325.   (* Tausche alle Cluster des Files mit den Clustern ab DestCluster,
  326.      Als Seiteneffekt wird DestCluster erhöht und Cluster in NewFAT
  327.      verkettet.
  328.   *)
  329.     TYPE Operation = (wr,rd);
  330.  
  331.     VAR SourceCluster: ClusterIndex; (* tatsächliche Position für Cluster *)
  332.         OldDest      : ClusterIndex; (* ehemalige Position für DestCluster*)
  333.         Predecessor  : ClusterIndex; (* zuletzt geschriebener Cluster     *)
  334.         Current      : ClusterIndex; (* ehemalige Position lfd. Cluster   *)
  335.         A,B          : DirectoryArray; (* Puffer für je einen Cluster     *)
  336.  
  337.      PROCEDURE OK(Op   : Operation;
  338.                   VAR X: DirectoryArray;
  339.                      Cl: ClusterIndex): BOOLEAN;
  340.        VAR err: CARDINAL;
  341.        
  342.      BEGIN
  343.        IF Op = rd THEN
  344.          ReadAbs(ADR(X), SectorsPerCluster, ClusterToSector(Cl), err);
  345.          IF err#0 THEN
  346.            WriteString('Warnung: Fehler beim Lesen von Cluster ');
  347.            WriteCard(Cl,1);
  348.            WriteString(' (Cluster nicht verschoben) ');
  349.            Read (CH)
  350.          END;
  351.        ELSE
  352.          WriteAbs(ADR(X), SectorsPerCluster, ClusterToSector(Cl), err);
  353.          IF err#0 THEN
  354.            WriteString('Warnung: Fehler beim Schreiben von Cluster ');
  355.            WriteCard(Cl,1);
  356.            WriteString(' (Cluster nicht verschoben) ');
  357.            Read (CH)
  358.          END;
  359.        END;
  360.        RETURN err=0;
  361.      END OK;
  362.     
  363.   BEGIN
  364.     Predecessor:= 0;
  365.     WHILE Cluster<EOFCluster DO
  366.       LOOP
  367.        (* Lasse defekte Cluster als Ziel aus: *)
  368.         WHILE SwapLH(OrgFAT[DestCluster])=BadCluster DO
  369.           INC(DestCluster)
  370.         END;
  371.         IF DestCluster<BPBPtr^.numcl THEN EXIT END;
  372.         (* sollte eigentlich nicht passieren: *)
  373.         WriteLn;
  374.         WriteString('Warnung: Zu wenige freie Cluster ');
  375.         WriteLn;
  376.         Read (CH);
  377.         IF FirstFreeDestCluster = 0 THEN
  378.           (* vermeide Endlosschleife: *)
  379.           Abort('Fataler Fehler: Keine freien Cluster mehr gefunden', FALSE);
  380.         ELSE
  381.           DestCluster:= FirstFreeDestCluster;
  382.           FirstFreeDestCluster:= 0;
  383.         END;
  384.       END;
  385.  
  386.       (* Tausche jetzt NewPos[Cluster] mit DestCluster:                   *)
  387.       SourceCluster:= NewPos[Cluster];
  388.       OldDest:= OldPos[DestCluster];
  389.       Current:= SourceCluster;
  390.       (* vorläufig, wird überschrieben, falls Block-Austausch erfolgreich *)
  391.       IF OrgFAT[OldDest]=FreeCluster THEN
  392.         (* Ziel-Cluster ist frei, kann direkt überschrieben werden *)
  393.         WriteCard(SourceCluster,6); WriteString('->');
  394.         IF OK(rd,A,SourceCluster) AND OK(wr,A,DestCluster) THEN
  395.           NewPos[Cluster]:= DestCluster;
  396.           NewPos[OldDest]:= SourceCluster;
  397.           OldPos[SourceCluster]:= OldDest;
  398.           OldPos[DestCluster]:= Cluster;
  399.           Current:= DestCluster;
  400.         END;
  401.       ELSIF SourceCluster#DestCluster THEN
  402.         WriteCard(SourceCluster,6); WriteString('<>');
  403.         IF OK(rd,A,SourceCluster) THEN
  404.           IF OK(rd,B,DestCluster) THEN
  405.             IF OK(wr,B,SourceCluster) THEN
  406.               IF OK(wr,A,DestCluster) THEN
  407.                 NewPos[Cluster]:= DestCluster;
  408.                 NewPos[OldDest]:= SourceCluster;
  409.                 OldPos[SourceCluster]:= OldDest;
  410.                 OldPos[DestCluster]:= Cluster;
  411.                 Current:= DestCluster;
  412.               ELSE
  413.                 (* mache vorherigen Schreibvorgang rückgängig: *)
  414.                 IF NOT OK(wr,A,SourceCluster) AND
  415.                    NOT OK(wr,A,SourceCluster) THEN (* 2-mal *)
  416.                   WriteLn;
  417.                   WriteString('Fataler Fehler: Inhalt des Clusters ');
  418.                   WriteCard(SourceCluster,4);
  419.                   WriteString(' zerstört');
  420.                   WriteLn;
  421.                   Read (CH)
  422.                 END;
  423.               END;
  424.             END;
  425.           END;
  426.         END;
  427.       END; (* IF unused *)
  428.  
  429.       (* Verkette mit Vorgänger *)
  430.       IF Predecessor#0 THEN
  431.         IF NewFAT[Predecessor]#FreeCluster THEN
  432.           WriteLn; WriteString('Warnung: Cluster doppelt belegt ');
  433.           WriteCard(Predecessor,4); WriteLn;
  434.           Read (CH)
  435.         END;
  436.         NewFAT[Predecessor]:= SwapLH(Current);
  437.       END;
  438.       Predecessor:= Current;
  439.       Cluster:= Next(Cluster);
  440.       INC(DestCluster);
  441.     END; (* WHILE *)
  442.  
  443.     IF Predecessor#0 THEN
  444.         IF NewFAT[Predecessor]#FreeCluster THEN
  445.           WriteLn; WriteString('Warnung: Cluster doppelt belegt ');
  446.           WriteCard(Predecessor,4); WriteLn;
  447.           Read (CH)
  448.         END;
  449.       NewFAT[Predecessor]:= SwapLH(MaxCluster);
  450.     END;
  451.   END MoveFile;
  452.   
  453.   PROCEDURE CompactDirectory (StartCl: CARDINAL);
  454.   (* Schreibe Subdirectories adjazent ab Cluster 2, aktualisiere NewFAT
  455.   *)
  456.     VAR i,x: CARDINAL;
  457.         r  : DirectoryRecord;
  458.  
  459.   BEGIN
  460.     (* Nur falls nicht Wurzelverzeichnis ist Verschieben möglich:        *)
  461.     IF StartCl#0 THEN MoveFile(StartCl); END;
  462.  
  463.     (* Verschiebe jetzt die geschachtelten Verzeichnisse:                *)
  464.     i:= 0;
  465.     WHILE GetDirectoryRecord(StartCl,i,r) DO
  466.       WITH r DO
  467.         x:= ORD(Name[0]);
  468.         IF (x <> UnusedName) AND
  469.            (x <> SpecialName) AND                (* nicht '.' und '..' ! *)
  470.            (subdirattr IN Attr) THEN
  471.           WriteLn; WriteString(Name); Write(':'); WriteLn;
  472.           CompactDirectory(SwapLH(StartCluster));
  473.         END;
  474.       END;
  475.       INC(i);
  476.     END; (* WHILE *)
  477.   END CompactDirectory;
  478.  
  479.   PROCEDURE CompactFiles (StartCl: CARDINAL);
  480.   (* schreibe Datenfiles adjazent bis zum Plattenende, aktualisiere NewFAT
  481.    *)
  482.     VAR i,x: CARDINAL;
  483.         r  : DirectoryRecord;
  484.  
  485.   BEGIN
  486.     i:= 0;
  487.     WHILE GetDirectoryRecord(StartCl,i,r) DO
  488.       WITH r DO
  489.         x:= ORD(Name[0]);
  490.         IF (x <> UnusedName) AND (x <> SpecialName) THEN
  491.           IF subdirattr IN Attr THEN     (* rekursiv die Söhne bearbeiten *)
  492.             CompactFiles(SwapLH(StartCluster));
  493.           ELSE
  494.             WriteLn; WriteString(Name); Write(':'); WriteLn;
  495.             IF Size#0L THEN
  496.               MoveFile(SwapLH(StartCluster));
  497.             END;
  498.           END;
  499.         END;
  500.       END;
  501.       INC(i);
  502.     END; (* WHILE *)
  503.   END CompactFiles;
  504.  
  505.   PROCEDURE UpdateLinks (StartCl: CARDINAL);
  506.   (* ersetzte Eintrag StartCluster für jedes File und Unterverzeichnis
  507.      durch seinen neuen Wert.
  508.   *)
  509.     VAR i,x, Start: CARDINAL;
  510.         r         : DirectoryRecord;
  511.  
  512.   BEGIN
  513.     i:= 0;
  514.     WHILE GetDirectoryRecord(StartCl,i,r) DO
  515.       WITH r DO
  516.         x:= ORD(Name[0]);
  517.         Start:= SwapLH(StartCluster);
  518.         IF (x <> UnusedName) THEN            (* auch für '.' und '..' ! *)
  519.           IF (subdirattr IN Attr) AND (x<>SpecialName) THEN
  520.             UpdateLinks(Start);
  521.           END;
  522.           WriteLn; WriteString(Name); Write(':');
  523.           IF (Start>=FirstCluster) AND (Start<=MaxPhysCluster) THEN
  524.             StartCluster:=SwapLH(NewPos[Start]);
  525.             WriteCard(SwapLH(StartCluster),4);
  526.             IF NOT PutDirectoryRecord(StartCl,i,r) THEN
  527.               WriteLn;
  528.               WriteString('Fehler: StartCluster für File ');
  529.               WriteString(Name);
  530.               WriteString(' konnte nicht auf den Wert ');
  531.               WriteCard(SwapLH(StartCluster),4);
  532.               WriteString(' aktualisiert werden!'); WriteLn;
  533.               Read (CH)
  534.             END;
  535.           END;
  536.         END;
  537.       END;
  538.       INC(i);
  539.     END; (* WHILE *)
  540.   END UpdateLinks;
  541.  
  542.   PROCEDURE MakeNewFAT;
  543.   (* Erzeuge leere NewFAT, in der fehlerhafte Cluster bereits markiert sind
  544.   *)
  545.   VAR i: CARDINAL;
  546.   BEGIN
  547.     NewFAT[0]:= OrgFAT[0];
  548.     NewFAT[1]:= OrgFAT[1];
  549.     FOR i:= FirstCluster TO BPBPtr^.numcl-1 DO
  550.       IF SwapLH(OrgFAT[i])=BadCluster THEN
  551.         NewFAT[i]:= SwapLH(BadCluster);
  552.       ELSE
  553.         NewFAT[i]:= FreeCluster;
  554.       END;
  555.     END;
  556.   END MakeNewFAT;
  557.    
  558.   VAR i         : CARDINAL;
  559.       errorcode : CARDINAL;
  560.       NumberFree: CARDINAL;
  561.    
  562. BEGIN (* Hauptprogramm *)
  563.   Write(CHR(27)); Write('v'); Write(CHR(27)); Write('E');
  564.   WriteString('HDPack:'); WriteLn;
  565.   WriteString('-------'); WriteLn; WriteLn;
  566.   WriteString('Version 1.2  18.10.1987  Florian Matthes'); WriteLn; WriteLn;
  567.   REPEAT
  568.     CH:='0'; WriteLn;
  569.     WriteString("Buchstabe des logischen Laufwerkes (z.B. 'C') ==>");
  570.     Read(CH); CH:= CAP(CH); Write(CH); WriteLn;
  571.   UNTIL (CH>='A') AND (CH<='Z');
  572.   dev:= ORD(CH)-ORD("A");
  573.  
  574.   WriteLn;
  575.   WriteString('Bitte bestätigen Sie die Optimierung für Laufwerk ');
  576.   Write(CHR(dev+ORD('A'))); WriteString(': '); WriteLn;
  577.   WriteString("durch die Eingabe des Buchstabens 'P'!"); WriteLn;
  578.   WriteLn; WriteString('W A R N U N G'); WriteLn;
  579.   WriteString("Unterbrechen Sie keinesfalls den Programmablauf nach der");
  580.   WriteLn;
  581.   WriteString("Eingabe von 'P', da dies sicher zum Verlust von Dateien und ");
  582.   WriteLn;
  583.   WriteString('Directories führen würde!'); WriteLn; WriteLn;
  584.   WriteString('==>'); Read(CH); Write(CH); WriteLn;
  585.   IF CAP(CH)#'P' THEN
  586.     Abort('OK: Programmabbruch durch den Benutzer', TRUE);
  587.   END;
  588.  
  589.   BPBPtr:= BIOS.GetBPB(dev);
  590.   IF ADDRESS(BPBPtr) = ADDRESS(0L) THEN
  591.     Abort('Parameter Block nicht gefunden (Laufwerksbuchstabe prüfen)!', TRUE);
  592.   END;
  593.   (* bestimme die geräteabhängingen Parameter und speichere sie global: *)
  594.   WITH BPBPtr^ DO
  595.     SectorsPerCluster        := clsiz;
  596.     FirstDataSector          := datrec;
  597.     DirectoryRecordsPerSector:= recsiz DIV SHORT (TSIZE(DirectoryRecord));
  598.     FirstDirectorySector     := BPBPtr^.fatrec+BPBPtr^.fsiz;
  599.     IF numcl>MaxCluster THEN
  600.       Abort('Platte besitzt zu viele (>16384) Cluster!', TRUE);
  601.     (*
  602.     ELSIF numcl<4096 THEN
  603.       Abort(
  604.       'FAT ist nicht wortweise organisiert. HDPack läuft nicht für Floppies',      TRUE);
  605.     *)
  606.     ELSIF DirectoryRecordsPerSector>MaxDirectoryBlocks THEN
  607.       Abort('Sectorgröße auf dem Laufwerk zu groß (>65355 Bytes)', TRUE);
  608.     END;
  609.   END;
  610.   WriteString('Parameter Block gelesen...'); WriteLn;
  611.  
  612.   ReadAbs(ADR(OrgFAT),           (* hole FAT                     *)
  613.           BPBPtr^.fsiz,          (* Anzahl Sektoren = Laenge FAT *)
  614.           1, errorcode);         (* 1. Sektor = 1. Sektor FAT    *)
  615.   IF errorcode#0 THEN
  616.     WriteString('Errorcode ='); WriteCard(errorcode,4); WriteLn;
  617.     Abort('Fehler beim Lesen von FAT 1.', TRUE);
  618.   END;
  619.   WriteString('FAT 1 gelesen...'); WriteLn;
  620.  
  621.   ReadAbs(ADR(OldPos),           (* hole 2.FAT                   *)
  622.           BPBPtr^.fsiz,          (* Anzahl Sektoren = Laenge FAT *)
  623.           BPBPtr^.fatrec,        (* 1. Sektor = 1. Sektor FAT    *)
  624.           errorcode);
  625.   IF errorcode#0 THEN
  626.     WriteString('Errorcode ='); WriteCard(errorcode,4); WriteLn;
  627.     Abort('Fehler beim Lesen von FAT 2.', TRUE);
  628.   END;
  629.   WriteString('FAT 2 gelesen...'); WriteLn;
  630.   
  631.   errorcode:= 0;
  632.   FOR i:= 0 TO BPBPtr^.numcl-1 DO
  633.     IF OrgFAT[i] # OldPos[i] THEN
  634.       INC(errorcode);
  635.       WriteCard(i,6); WriteCard(OrgFAT[i],6); WriteCard(OldPos[i],6);
  636.       WriteLn;
  637.     END;
  638.   END;
  639.   IF errorcode=0 THEN
  640.     WriteString('Gleichheit von FAT 1 und FAT 2 überprüft...'); WriteLn;
  641.   ELSE
  642.     Abort('FAT1 unterscheidet sich von FAT2 in den obigen Clustern', TRUE);
  643.   END;
  644.  
  645.   FOR i:= 0 TO BPBPtr^.numcl-1 DO
  646.     NewPos[i]:= i; OldPos[i]:= i;
  647.   END;
  648.  
  649.   NumberFree:= CountFree();
  650.   WriteCard(NumberFree,1);
  651.   WriteString(' Cluster noch unbelegt...');
  652.   WriteLn;
  653.  
  654.   WriteString('Sortiere Directories...'); WriteLn;
  655.   SortDirectory(0);
  656.  
  657.   WriteLn; WriteString('Erstelle leere FAT...');
  658.   MakeNewFAT;
  659.   WriteLn;
  660.  
  661.   DestCluster:= FirstCluster;
  662.   FirstFreeDestCluster:= 0; (* noch nicht bestimmt *)
  663.   CompactDirectory(0);
  664.   WriteLn;
  665.  
  666.   FirstFreeDestCluster:= DestCluster;
  667.   (* erstes Cluster nach den Directories *)
  668.   DestCluster:= FirstFreeDestCluster + NumberFree;
  669.   CompactFiles(0);
  670.  
  671.   WriteLn;
  672.   WriteString('Aktualisiere Anfangscluster...'); WriteLn;
  673.   UpdateLinks(0);
  674.   WriteLn;
  675.  
  676.   WriteAbs(ADR(NewFAT),          (* Schreibe FAT                 *)
  677.           BPBPtr^.fsiz,          (* Anzahl Sektoren = Laenge FAT *)
  678.           1, errorcode);         (* 1. Sektor = 1. Sektor FAT    *)
  679.   IF errorcode#0 THEN
  680.     WriteString('Fehler beim Schreiben von FAT 1: Code =');
  681.     WriteCard(errorcode,4); WriteLn;
  682.   END;
  683.   WriteString('FAT 1 geschrieben...'); WriteLn;
  684.  
  685.   WriteAbs(ADR(NewFAT),          (* schreibe 2.FAT               *)
  686.           BPBPtr^.fsiz,          (* Anzahl Sektoren = Laenge FAT *)
  687.           BPBPtr^.fatrec,        (* 1. Sektor = 1. Sektor FAT    *)
  688.           errorcode);
  689.   IF errorcode#0 THEN
  690.     WriteString('Fehler beim Schreiben von FAT2: Code =');
  691.     WriteCard(errorcode,4); WriteLn;
  692.   END;
  693.   WriteString('FAT 2 geschrieben...'); WriteLn;
  694.   WriteString('HDPACK erfolgreich beendet.'); WriteLn; WriteLn;
  695.   WriteString('Bitte drücken Sie <RESET> um das System erneut zu booten!');
  696.   WriteLn;
  697.   WriteString('(dies ist zur Initialisierung des DESKTOP erforderlich)');
  698.   WriteLn;
  699.   LOOP END; (* Endlosschleife *)
  700. END HDPack.
  701.  
  702. (* $00004738$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$000030E5$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9$FFF6C6C9Ç$00005460T.......T.......T.......T.......T.......T....T..T.......T.......T.......T.......$000043DF$00005205$000038FF$00003A30$00003C30$00004550$000046DD$00000180$FFF673D6$00002A76$00001399$0000135B$0000134D$00005460$000030EA$000031C0ÕÇü*)
  703.